home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / OPS.Mod (.txt) < prev    next >
Oberon Text  |  1995-06-10  |  10KB  |  296 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. (* Notify Ralf for maintenance of Non-FPU source *)
  4. MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *)
  5.  IMPORT OPM;
  6.  CONST
  7.   MaxStrLen* = 256;
  8.   MaxIdLen = 24;
  9.  TYPE
  10.   Name* = ARRAY MaxIdLen OF CHAR;
  11.   String* = ARRAY MaxStrLen OF CHAR;
  12.  (* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
  13.   name*: Name;
  14.   str*: String;
  15.   numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
  16.   intval*: LONGINT; (* integer value or string length *)
  17.   realval*: REAL;
  18.   lrlval*: LONGREAL;
  19.  (*symbols:
  20.      |  0          1          2          3          4
  21.   ---|--------------------------------------------------------
  22.    0 |  null       *          /          DIV        MOD
  23.    5 |  &          +          -          OR         =
  24.   10 |  #          <          <=         >          >=
  25.   15 |  IN         IS         ^          .          ,
  26.   20 |  :          ..         )          ]          }
  27.   25 |  OF         THEN       DO         TO         BY
  28.   30 |  (          [          {          ~          :=
  29.   35 |  number     NIL        string     ident      ;
  30.   40 |  |          END        ELSE       ELSIF      UNTIL
  31.   45 |  IF         CASE       WHILE      REPEAT     FOR
  32.   50 |  LOOP       WITH       EXIT       RETURN     ARRAY
  33.   55 |  RECORD     POINTER    BEGIN      CONST      TYPE
  34.   60 |  VAR        PROCEDURE  IMPORT     MODULE     eof    *)
  35.  CONST
  36.   (* numtyp values *)
  37.   char = 1; integer = 2; real = 3; longreal = 4;
  38.   (*symbol values*)
  39.   null = 0; times = 1; slash = 2; div = 3; mod = 4;
  40.   and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  41.   neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  42.   in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  43.   colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  44.   of = 25; then = 26; do = 27; to = 28; by = 29;
  45.   lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  46.   number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  47.   bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  48.   if = 45; case = 46; while = 47; repeat = 48; for = 49;
  49.   loop = 50; with = 51; exit = 52; return = 53; array = 54;
  50.   record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  51.   var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  52.   ch: CHAR;     (*current character*)
  53.  PROCEDURE err(n: INTEGER);
  54.  BEGIN OPM.err(n)
  55.  END err;
  56.  PROCEDURE Str(VAR sym: SHORTINT);
  57.   VAR i: INTEGER; och: CHAR;
  58.  BEGIN i := 0; och := ch;
  59.   LOOP OPM.Get(ch);
  60.    IF ch = och THEN EXIT END ;
  61.    IF ch < " " THEN err(3); EXIT END ;
  62.    IF i = MaxStrLen-1 THEN err(241); EXIT END ;
  63.    str[i] := ch; INC(i)
  64.   END ;
  65.   OPM.Get(ch); str[i] := 0X; intval := i + 1;
  66.   IF intval = 2 THEN
  67.    sym := number; numtyp := 1; intval := ORD(str[0])
  68.   ELSE sym := string
  69.   END
  70.  END Str;
  71.  PROCEDURE Identifier(VAR sym: SHORTINT);
  72.   VAR i: INTEGER;
  73.  BEGIN i := 0;
  74.   REPEAT
  75.    name[i] := ch; INC(i); OPM.Get(ch)
  76.   UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
  77.   IF i = MaxIdLen THEN err(240); DEC(i) END ;
  78.   name[i] := 0X; sym := ident
  79.  END Identifier;
  80.  PROCEDURE Number;
  81.   VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
  82.   PROCEDURE Ten(e: INTEGER): LONGREAL;
  83.    VAR x, p: LONGREAL;
  84.   BEGIN x := 1; p := 10;
  85.    WHILE e > 0 DO
  86.     IF ODD(e) THEN x := x*p END;
  87.     e := e DIV 2;
  88.     IF e > 0 THEN p := p*p END (* prevent overflow *)
  89.    END;
  90.    RETURN x
  91.   END Ten;
  92.   PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
  93.   BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
  94.    IF ch <= "9" THEN RETURN ORD(ch) - ORD("0")
  95.    ELSIF hex THEN RETURN ORD(ch) - ORD("A") + 10
  96.    ELSE err(2); RETURN 0
  97.    END
  98.   END Ord;
  99.  BEGIN (* ("0" <= ch) & (ch <= "9") *)
  100.   i := 0; m := 0; n := 0; d := 0;
  101.   LOOP (* read mantissa *)
  102.    IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
  103.     IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
  104.      IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
  105.      INC(m)
  106.     END;
  107.     OPM.Get(ch); INC(i)
  108.    ELSIF ch = "." THEN OPM.Get(ch);
  109.     IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
  110.     ELSIF d = 0 THEN (* i > 0 *) d := i
  111.     ELSE err(2)
  112.     END
  113.    ELSE EXIT
  114.    END
  115.   END; (* 0 <= n <= m <= i, 0 <= d <= i *)
  116.   IF d = 0 THEN (* integer *)
  117.    IF n = m THEN intval := 0; i := 0;
  118.     IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char;
  119.      IF n <= 2 THEN
  120.       WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
  121.      ELSE err(203)
  122.      END
  123.     ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
  124.      IF n <= OPM.MaxHDig THEN
  125.       IF (n = OPM.MaxHDig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
  126.       WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
  127.      ELSE err(203)
  128.      END
  129.     ELSE (* decimal *) numtyp := integer;
  130.      WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
  131.       IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
  132.       ELSE err(203)
  133.       END
  134.      END
  135.     END
  136.    ELSE err(203)
  137.    END
  138.   ELSE (* fraction *)
  139.    f := 0; e := 0; expCh := "E";
  140.    WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
  141.    IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
  142.     IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
  143.     ELSIF ch = "+" THEN OPM.Get(ch)
  144.     END;
  145.     IF ("0" <= ch) & (ch <= "9") THEN
  146.      REPEAT n := Ord(ch, FALSE); OPM.Get(ch);
  147.       IF e <= (MAX(INTEGER) - n) DIV 10 THEN e := e*10 + n
  148.       ELSE err(203)
  149.       END
  150.      UNTIL (ch < "0") OR ("9" < ch);
  151.      IF neg THEN e := -e END
  152.     ELSE err(2)
  153.     END
  154.    END;
  155.    DEC(e, i-d-m); (* decimal point shift *)
  156.    IF expCh = "E" THEN numtyp := real;
  157.     IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
  158.      IF e < 0 THEN realval := SHORT(f / Ten(-e))
  159.      ELSE realval := SHORT(f * Ten(e))
  160.      END
  161.     ELSE err(203)
  162.     END
  163.    ELSE numtyp := longreal;
  164.     IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
  165.      IF e < 0 THEN lrlval := f / Ten(-e)
  166.      ELSE lrlval := f * Ten(e)
  167.      END
  168.     ELSE err(203)
  169.     END
  170.    END
  171.   END
  172.  END Number;
  173.  PROCEDURE Get*(VAR sym: SHORTINT);
  174.   VAR s: SHORTINT;
  175.   PROCEDURE Comment; (* do not read after end of file *)
  176.   BEGIN OPM.Get(ch);
  177.    LOOP
  178.     LOOP
  179.      WHILE ch = "(" DO OPM.Get(ch);
  180.       IF ch = "*" THEN Comment END
  181.      END ;
  182.      IF ch = "*" THEN OPM.Get(ch); EXIT END ;
  183.      IF ch = OPM.Eot THEN EXIT END ;
  184.      OPM.Get(ch)
  185.     END ;
  186.     IF ch = ")" THEN OPM.Get(ch); EXIT END ;
  187.     IF ch = OPM.Eot THEN err(5); EXIT END
  188.    END
  189.   END Comment;
  190.  BEGIN
  191.   OPM.errpos := OPM.curpos-1;
  192.   WHILE ch <= " " DO (*ignore control characters*)
  193.    IF ch = OPM.Eot THEN sym := eof; RETURN
  194.    ELSE OPM.Get(ch)
  195.    END
  196.   END ;
  197.   CASE ch OF   (* ch > " " *)
  198.    | 22X, 27X  : Str(s)
  199.    | "#"  : s := neq; OPM.Get(ch)
  200.    | "&"  : s :=  and; OPM.Get(ch)
  201.    | "("  : OPM.Get(ch);
  202.         IF ch = "*" THEN Comment; Get(s)
  203.          ELSE s := lparen
  204.         END
  205.    | ")"  : s := rparen; OPM.Get(ch)
  206.    | "*"  : s :=  times; OPM.Get(ch)
  207.    | "+"  : s :=  plus; OPM.Get(ch)
  208.    | ","  : s := comma; OPM.Get(ch)
  209.    | "-"  : s :=  minus; OPM.Get(ch)
  210.    | "."  : OPM.Get(ch);
  211.         IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END
  212.    | "/"  : s := slash;  OPM.Get(ch)
  213.    | "0".."9": Number; s := number
  214.    | ":"  : OPM.Get(ch);
  215.         IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END
  216.    | ";"  : s := semicolon; OPM.Get(ch)
  217.    | "<"  : OPM.Get(ch);
  218.         IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END
  219.    | "="  : s :=  eql; OPM.Get(ch)
  220.    | ">"  : OPM.Get(ch);
  221.         IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END
  222.    | "A": Identifier(s); IF name = "ARRAY" THEN s := array END
  223.    | "B": Identifier(s);
  224.       IF name = "BEGIN" THEN s := begin
  225.       ELSIF name = "BY" THEN s := by
  226.       END
  227.    | "C": Identifier(s);
  228.       IF name = "CASE" THEN s := case
  229.       ELSIF name = "CONST" THEN s := const
  230.       END
  231.    | "D": Identifier(s);
  232.       IF name = "DO" THEN s := do
  233.       ELSIF name = "DIV" THEN s := div
  234.       END
  235.    | "E": Identifier(s);
  236.       IF name = "END" THEN s := end
  237.       ELSIF name = "ELSE" THEN s := else
  238.       ELSIF name = "ELSIF" THEN s := elsif
  239.       ELSIF name = "EXIT" THEN s := exit
  240.       END
  241.    | "F": Identifier(s); IF name = "FOR" THEN s := for END
  242.    | "I": Identifier(s);
  243.       IF name = "IF" THEN s := if
  244.       ELSIF name = "IN" THEN s := in
  245.       ELSIF name = "IS" THEN s := is
  246.       ELSIF name = "IMPORT" THEN s := import
  247.       END
  248.    | "L": Identifier(s); IF name = "LOOP" THEN s := loop END
  249.    | "M": Identifier(s);
  250.       IF name = "MOD" THEN s := mod
  251.       ELSIF name = "MODULE" THEN s := module
  252.       END
  253.    | "N": Identifier(s); IF name = "NIL" THEN s := nil END
  254.    | "O": Identifier(s);
  255.       IF name = "OR" THEN s := or
  256.       ELSIF name = "OF" THEN s := of
  257.       END
  258.    | "P": Identifier(s);
  259.       IF name = "PROCEDURE" THEN s := procedure
  260.       ELSIF name = "POINTER" THEN s := pointer
  261.       END
  262.    | "R": Identifier(s);
  263.       IF name = "RECORD" THEN s := record
  264.       ELSIF name = "REPEAT" THEN s := repeat
  265.       ELSIF name = "RETURN" THEN s := return
  266.       END
  267.    | "T": Identifier(s);
  268.       IF name = "THEN" THEN s := then
  269.       ELSIF name = "TO" THEN s := to
  270.       ELSIF name = "TYPE" THEN s := type
  271.       END
  272.    | "U": Identifier(s); IF name = "UNTIL" THEN s := until END
  273.    | "V": Identifier(s); IF name = "VAR" THEN s := var END
  274.    | "W": Identifier(s);
  275.       IF name = "WHILE" THEN s := while
  276.       ELSIF name = "WITH" THEN s := with
  277.       END
  278.    | "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
  279.    | "["  : s := lbrak; OPM.Get(ch)
  280.    | "]"  : s := rbrak; OPM.Get(ch)
  281.    | "^"  : s := arrow; OPM.Get(ch)
  282.    | "a".."z": Identifier(s)
  283.    | "{"  : s := lbrace; OPM.Get(ch)
  284.    | "|"  : s := bar; OPM.Get(ch)
  285.    | "}"  : s := rbrace; OPM.Get(ch)
  286.    | "~"  : s := not; OPM.Get(ch)
  287.    | 7FX  : s := upto; OPM.Get(ch)
  288.   ELSE s :=  null; OPM.Get(ch)
  289.   END ;
  290.   sym := s
  291.  END Get;
  292.  PROCEDURE Init*;
  293.  BEGIN ch := " "
  294.  END Init;
  295. END OPS.
  296.